home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / breeze30.zip / CALC.PRG < prev    next >
Text File  |  1993-01-04  |  9KB  |  342 lines
  1. *----------------------->LOGITEK<--------------------------------------
  2. *
  3. *   All Registered Users are free to modify and use this source code
  4. *   as they see fit, with no royalties, obligations or fees to LOGITEK.
  5. *
  6. *-----------------------------------------------------------------------
  7. *   y,x - upper left corner of calc. coordinate on screen
  8. *   calcwind - window select area to use
  9. *   color1,color2 - color strings
  10. *************************************************************************
  11.  
  12. parameters color1,color2,y,x,calcwind
  13.  
  14.                  * if necessary, adjust coordinates so that calculator does not
  15.                  * exceed the screen
  16.  
  17. result = 0
  18. ok = .t.
  19. x = IF(x > 48,48,x)
  20. y = IF(y > 11,11,y)
  21.  
  22. DO disp_calc with color1,color2              && display calculator
  23.  
  24. op = ""                                      && operator
  25. op_old = ""                                  && LASTKEY operator
  26. mov = .t.                                    && flag: move calculator
  27. result = 0                                   && result
  28. noerr = .t.                                  && error flag
  29. *
  30. * main loop - do it until entry is "x" or "e" (esc)
  31. *
  32. DO WHILE ! (op $ "XE" )
  33.    *
  34.    * read first operand and first operator
  35.    *
  36.    num = "0"
  37.    DO getnum WITH num,op,x,y,op # "="
  38.    *
  39.    * handle result key, end, or clear entry
  40.    *
  41.    IF op $ "=XEC"
  42.       IF ((op = "X" ) .AND. (op_old # "=" )) .OR. (op = "=" )
  43.          result = val(num)
  44.       ENDIF ((op = "X" ) .AND. (op_old # "=" )) .OR. (op = "=" )
  45.       op_old = op
  46.       wprint(2,3,STR(result,21,4))
  47.       wprint(2,24," ")
  48.       LOOP
  49.    ENDIF op $ "=XEC"
  50.    *
  51.    * store first operand into result
  52.    *
  53.    result = val(num)
  54.    *
  55.    * read more operands and operators
  56.    *
  57.    DO WHILE .t.
  58.       op_old = op
  59.       DO getnum WITH num,op,x,y,.f.
  60.       *
  61.       * handle clear entry or end
  62.       *
  63.       IF op $ "XEC"
  64.          EXIT
  65.       ENDIF op $ "XEC"
  66.       *
  67.       * calculate...
  68.       *
  69.       result = calculate(result,num,op_old)
  70.       *
  71.       * overflow or divide by zero error ?
  72.       *
  73.       noerr = IF(result = 9999999999999999999999,.f.,.t.)
  74.       *
  75.       * display result
  76.       *
  77.       wprint(2,3,STR(result,21,4))
  78.       wprint(2,26," ")
  79.       *
  80.       * handle result key
  81.       *
  82.       IF op = "="
  83.          op_old = op
  84.          EXIT
  85.       ENDIF op = "="
  86.    ENDDO WHILE .t.
  87. ENDDO WHILE ! (op $ "xe" )
  88. *
  89. * set flag if result is ok
  90. *
  91. ok = IF(((op = "X" ) .AND. noerr),.t.,.f.)
  92. *
  93. *
  94.  
  95. wclose()                && close window, restore screen
  96. wrelease()              && release window from memory
  97.  
  98. RETURN
  99. *
  100. * function to calculate the results
  101. *
  102. FUNCTION calculate
  103. PARAMETERS result,num,operator
  104. DO CASE
  105.    CASE operator = "+"
  106.       RETURN(result + val(num))
  107.    CASE operator = "-"
  108.       RETURN(result - val(num))
  109.    CASE operator = "*"
  110.       RETURN(result * val(num))
  111.    CASE operator = "/"
  112.       IF val(num) = 0
  113.          sound(800,10)
  114.          RETURN(9999999999999999999999)
  115.          noerr = .f.
  116.       ELSE
  117.          RETURN(result / val(num))
  118.          noerr = .t.
  119.       ENDIF val(num) = 0
  120. ENDCASE
  121. *
  122. * read a number into "num" and operand into "op"
  123. *
  124. * location for display is determined by x and y
  125. *
  126. * first clear the display if cl = .t.
  127. *
  128. PROCEDURE getnum
  129. PARAMETERS num,op,x,y,cl
  130. num = "0"
  131. inp_dec = .f.
  132. mant_len = 1
  133. dec_len = 0
  134. *
  135. * clear display if needed
  136. *
  137. IF cl
  138.    wprint(2,3,STR(val(num),16,0) + "       ")
  139.    wprint(2,24," ")
  140. ENDIF cl
  141. *
  142. *main loop for character entry
  143. *
  144. DO WHILE .t.
  145.    ch = getkey()
  146.    DO CASE
  147.       CASE ch $ "+-*/=XCE" && operands AND special keys
  148.          op = ch
  149.          wprint(2,24,ch)
  150.          EXIT
  151.       CASE ch = "B" && backspace (CLEAR entry)
  152.          num = "0"
  153.          mant_len = 1
  154.          dec_len = 0
  155.          inp_dec = .f.
  156.          wprint(2,3,STR(val(num),16,0) + "        ")
  157.          wprint(2,24," ")
  158.       CASE ch = "V" && change sign
  159.          num = IF(((inp_dec) .AND. (dec_len=0)), ;
  160.          LTRIM(STR(-val(num),16,0)) + "." , ;
  161.          LTRIM(STR(-val(num),16,dec_len)))
  162.       CASE ch = "." && DECIMALS point
  163.          IF inp_dec && already there ?
  164.             sound(800,10)
  165.          ELSE && no, DO it
  166.             num = num + "."
  167.             inp_dec = .t.                    && DECIMALS flag
  168.          ENDIF inp_dec                       && already there ?
  169.       OTHERWISE                              && enter a number KEY
  170.          IF ! inp_dec                        && we are left of dec. point
  171.             IF num = "0"                     && just started ?
  172.                num = ch                      && this is our first digit
  173.             ELSE
  174.                IF mant_len = 10              && overflow ?
  175.                   sound(800,10)
  176.                ELSE
  177.                   num = num + ch             && no, i LIKE this digit
  178.                   mant_len = mant_len + 1    && digit counter
  179.                ENDIF mant_len = 10           && overflow ?
  180.             ENDIF num = "0"                  && just started ?
  181.          ELSE && we INPUT DECIMALS now
  182.             IF dec_len = 4                   && overflow ?
  183.                sound(800,10)
  184.             ELSE && no, we LIKE this digit
  185.                num = num + ch
  186.                dec_len = dec_len + 1         && DECIMALS counter
  187.             ENDIF dec_len = 4                && overflow ?
  188.          ENDIF ! inp_dec                     && we are left of dec. point
  189.    ENDCASE
  190.    *
  191.    * display the number
  192.    *
  193.    IF inp_dec && DECIMALS point ?
  194.       IF dec_len = 0 && no DECIMALS
  195.          wprint(2,3,STR(val(num),16) + ".    ")
  196.       ELSE && there are DECIMALS
  197.          wprint(2,3,STR(val(num),17+dec_len,dec_len) + SPACE(4-dec_len))
  198.       ENDIF dec_len = 0                      && no DECIMALS
  199.    ELSE && no DECIMALS point
  200.       wprint(2,3,STR(val(num),16) + "     ")
  201.    ENDIF inp_dec                             && DECIMALS point ?
  202.    wprint(2,24," ")
  203. ENDDO WHILE .t.
  204. RETURN
  205. *
  206. * read keyboard entry
  207. *
  208. FUNCTION getkey
  209. DO WHILE .t.
  210.    *
  211.    * check the arrow keys if move is still active
  212.    *
  213.    DO WHILE .t.
  214.       c = INKEY(0)
  215.       IF mov .AND. ((c=5) .OR. (c=24) .OR. (c=19) ;
  216.          .OR. (c=4) .OR. (c=26) .OR. ;
  217.          (c=2) .OR. (c=1) .OR. (c=6))
  218.          DO mov_calc WITH c
  219.       ELSE
  220.          EXIT
  221.       ENDIF mov .AND. ((c=5) .OR. (c=24) .OR. (c=19) ;
  222.    ENDDO WHILE .t.
  223.    ch = UPPER(CHR(c))
  224.    DO CASE
  225.       CASE ch $ "0123456789+-*/=VXC."        && numbers OR special keys
  226.          RETURN(ch)
  227.       CASE c = 8                             && back SPACE
  228.          RETURN( "B" )
  229.       CASE ch = ","                          && comma -->dot (TO make the
  230.          RETURN( "." )
  231.       CASE c = 13                            && RETURN --> =
  232.          RETURN( "=" )
  233.       CASE c = 27                            && esc
  234.          RETURN( "E" )
  235.       OTHERWISE                              && we dont like other keys,
  236.          sound(800,10)
  237.    ENDCASE
  238. ENDDO WHILE .t.
  239. *
  240. * display calculator
  241. *
  242. ***************************************************************************
  243. PROCEDURE disp_calc
  244.  
  245. parameters color1,color2
  246. ***************************************************************************
  247.  
  248. wselect(calcwind)
  249. wuse(19,30,y,x,color2)
  250. wframe(2)
  251. wcolor(color1)
  252.  
  253. wframe(2,calcwind,1,2,3,27)
  254. wprint(2,3,space(24))
  255.  
  256. wcolor(color2)
  257. wframe(1,calcwind,4,5,6,7)
  258. wframe(1,calcwind,4,9,6,11)
  259. wframe(1,calcwind,4,13,6,15)
  260. wframe(1,calcwind,4,17,6,19)
  261. wframe(1,calcwind,4,21,6,23)
  262.  
  263. wcolor(color1)
  264. wprint(5,6,"=")
  265. wprint(5,10,"7")
  266. wprint(5,14,"8")
  267. wprint(5,18,"9")
  268. wprint(5,22,"-")
  269.  
  270. wcolor(color2)
  271. wframe(1,calcwind,7,5,9,7)
  272. wframe(1,calcwind,7,9,9,11)
  273. wframe(1,calcwind,7,13,9,15)
  274. wframe(1,calcwind,7,17,9,19)
  275. wframe(1,calcwind,7,21,11,23)
  276.  
  277. wcolor(color1)
  278. wprint(8,6,"/")
  279. wprint(8,10,"4")
  280. wprint(8,14,"5")
  281. wprint(8,18,"6")
  282.  
  283. wprint(8,22," ")
  284. wprint(9,22,"+")
  285. wprint(10,22," ")
  286.  
  287.  
  288. wcolor(color2)
  289. wframe(1,calcwind,10,5,12,7)
  290. wframe(1,calcwind,10,9,12,11)
  291. wframe(1,calcwind,10,13,12,15)
  292. wframe(1,calcwind,10,17,12,19)
  293.  
  294. wcolor(color1)
  295. wprint(11,6,"*")
  296. wprint(11,10,"1")
  297. wprint(11,14,"2")
  298. wprint(11,18,"3")
  299.  
  300. wcolor(color2)
  301. wframe(1,calcwind,13,5,15,7)
  302. wframe(1,calcwind,13,9,15,11)
  303. wframe(1,calcwind,13,13,15,15)
  304.  
  305.  
  306. wcolor(color1)
  307. wprint(14,6,".")
  308. wprint(14,10,chr(27))
  309. wprint(14,14,"0")
  310.  
  311. wcolor(color2)
  312. wline(16,0,16,29,2,1)
  313.  
  314. wcolor(color1)
  315. wprint(17,6,"C")
  316. wprint(17,10,"V=+/-")
  317.  
  318. wdisplay()
  319.  
  320. RETURN
  321.  
  322. *************************************************************************
  323. PROCEDURE mov_calc
  324. *************************************************************************
  325.  
  326. DO CASE
  327.  
  328.    CASE (c = 5)                && up arrow
  329.          wshift(1,calcwind,1)
  330.    CASE (c = 24)               && dwn arrow
  331.          wshift(3,calcwind,1)
  332.    CASE (c = 19)               && left arrow
  333.          wshift(4,calcwind,1)
  334.    CASE (c = 4)                && right arrow
  335.          wshift(2,calcwind,1)
  336.  
  337. ENDCASE
  338.  
  339. RETURN
  340.  
  341.  
  342.